home *** CD-ROM | disk | FTP | other *** search
/ Scene 96 / Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso / graphics / artpacks / acid0896 / adf2xbin.pas < prev    next >
Pascal/Delphi Source File  |  1996-05-18  |  21KB  |  494 lines
  1. {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V-,X+,Y+}
  2. {$M 4096,0,655360}
  3. PROGRAM ADF_TO_XBIN_Converter;
  4. (*****************************************************************************
  5.  
  6.  ADF to XBIN conversion program.
  7.  
  8.  ADF2XBIN converts an ADF file to a fully compliant compressed XBIN file.
  9.  
  10.  Compression routine is identical to the BIN2XBIN compression.  ADF is always
  11.  80 characters wide, which makes memory management somewhat simpler compared
  12.  to the BIN2XBIN utility.
  13.  
  14.  Any SAUCE info is stripped from the ADF.  As such SAUCEd ADF files should
  15.  properly convert to XBIN.
  16.  
  17.  Alternate palette and Font information is copied into the XBIN as-is.  No
  18.  checking is performed to see if the used palette and/or font match the
  19.  default.  If default font and/or palette are indeed used, they could be
  20.  stripped out of the XBIN.
  21.  
  22. *****************************************************************************)
  23.  
  24. USES  CRT,
  25.       DOS,
  26.       STM;
  27.  
  28. TYPE  Char2    = ARRAY [0..1]  OF Char;
  29.       Char4    = ARRAY [0..3]  OF Char;
  30.       Char5    = ARRAY [0..4]  OF Char;
  31.       Char8    = ARRAY [0..7]  OF Char;
  32.       Char20   = ARRAY [0..19] OF Char;
  33.       Char35   = ARRAY [0..34] OF Char;
  34.       Char64   = ARRAY [0..63] OF Char;
  35.  
  36.  
  37. { ================================= SAUCE ================================= }
  38.  
  39. Const SAUCE_ID      : Char5 = 'SAUCE';
  40.       CMT_ID        : Char5 = 'COMNT';
  41.  
  42. TYPE  SAUCERec = RECORD                { ┌── Implemented in Version ?        }
  43.                    ID       : Char5;   { 00  'SAUCE'                         }
  44.                    Version  : Char2;   { 00  '00'                            }
  45.                    Title    : Char35;  { 00  Title of the file               }
  46.                    Author   : Char20;  { 00  Creator of the file             }
  47.                    Group    : Char20;  { 00  Group creator belongs to        }
  48.                    Date     : Char8;   { 00  CCYYMMDD                        }
  49.                    FileSize : Longint; { 00  Original FileSize               }
  50.                    DataType : Byte;    { 00  Type of Data                    }
  51.                    FileType : Byte;    { 00  What type of file is it ?       }
  52.                    TInfo1   : Word;    { 00  \                               }
  53.                    TInfo2   : Word;    { 00   \ Type Info Zone               }
  54.                    TInfo3   : Word;    { 00   /                              }
  55.                    TInfo4   : Word;    { 00  /                               }
  56.                    Comments : Byte;    { 00  Number of Comment lines         }
  57.                    Flags    : Byte;    { 00* Bit flags                       }
  58.                    Filler   : Array[1..22] of Char;
  59.                  END;
  60.  
  61. { ================================== XBIN ================================= }
  62.  
  63. CONST XB_ID     : Char4 = 'XBIN';
  64. TYPE  XB_Header = RECORD
  65.                     ID      : Char4;
  66.                     EofChar : Byte;
  67.                     Width   : Word;
  68.                     Height  : Word;
  69.                     FontSize: Byte;
  70.                     Flags   : Byte;
  71.                   END;
  72.       BINChr    = RECORD               { BIN Character/Attribute pair. }
  73.                     CASE Boolean OF
  74.                     TRUE  : (
  75.                              CharAttr : Word;
  76.                             );
  77.                     FALSE : (
  78.                              Character : Byte;
  79.                              Attribute : Byte;
  80.                             );
  81.                   END;
  82.       BINChrAry = ARRAY[0..79] OF BINChr;  { This size is different from BIN2XBIN }
  83.  
  84.       { Conversion table for converting an EGA to VGA palette }
  85. CONST STD_EGA_TO_VGA_PAL : ARRAY [0..15] OF BYTE =
  86.                                 (0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);
  87.  
  88. VAR   XBHdr     : XB_Header;
  89.       SAUCE     : SauceRec;
  90.       CMT       : Char5;
  91.       ErrCode   : Integer;
  92.       XB, ADF   : STREAM;              { File stream, see STM unit }
  93.       Lines     : Word;
  94.       ADFSize   : Longint;
  95.       ADFFont   : ARRAY[0..4095] OF CHAR;
  96.       ADFPal    : ARRAY[0..191] OF CHAR;
  97.       BIN       : BinChrAry;
  98.       Counter   : Integer;
  99.  
  100.  
  101. { ABORT Execution and display error message }
  102. PROCEDURE Abort (Str: String);
  103. BEGIN
  104.    WriteLn;
  105.    WriteLn('ADF2XBIN V1.00.  Execution aborted.');
  106.    WriteLn;
  107.    WriteLn(Str);
  108.    WriteLn;
  109.    Halt(2);
  110. END;
  111.  
  112.  
  113. { Display command syntax and abort }
  114. PROCEDURE HelpText;
  115. BEGIN
  116.    WriteLn('ADF2XBIN converts ADF files to XBIN.');
  117.    WriteLn;
  118.    WriteLn('Correct Syntax:  ADF2XBIN <ADFFILE> <XBINFILE>');
  119.    WriteLn;
  120.    Halt(1);
  121. END;
  122.  
  123.  
  124. { Return size of File in Bytes or -1 if it does not exist or can't determine }
  125. { size                                                                       }
  126. FUNCTION FileExist (FName:String) : LongInt;
  127. VAR F      : FILE;
  128. BEGIN
  129.   {$i-}
  130.   ASSIGN(F,FName);
  131.   RESET(F,1);
  132.   IF (IOResult=0) THEN BEGIN
  133.      FileExist := FileSize(F);          { Return Size of file        }
  134.      IF (IOResult<>0) THEN
  135.         FileExist:=-1;                  { Return -1 : File not Found }
  136.      Close(F);
  137.   END
  138.   ELSE
  139.      FileExist:=-1;                     { Return -1 : File not Found }
  140.   {$i+}
  141. END;
  142.  
  143.  
  144. {███ XBIN Compression START █████████████████████████████████████████████████}
  145.  
  146. {
  147.   Introductory note.
  148.  
  149.   The XBIN compression used here is a single step compression algorythm.
  150.   What this means is that we will compress the data one character/attribute
  151.   pair at a time letting that char/attr pass through all the necessary
  152.   conditions until it has been decided what has to be done with it.
  153.   While not being the fastest or most compact algorythm available, it does
  154.   make the algorythm a lot easier to understand.
  155.  
  156.   This XBIN compression routine uses a temporary buffer (an array) to hold
  157.   the current run-count and compressed data.  Since the maximum run-count is
  158.   64, this buffer only needs to be 129 bytes in size (1 byte for the
  159.   run-count, and 64 times a char/attr pair when no compression is taking
  160.   place.
  161.  
  162.   The overall idea behind this routine is pretty simple..  here's the rough
  163.   outline:
  164.  
  165.   WHILE (Still_characters_to_process)
  166.      IF (A_run_is_busy)
  167.         IF (Stop_this_run_for_whatever_reason)
  168.            Write_run_to_disk;
  169.         ENDIF
  170.      ENDIF
  171.      IF (Run_is_still_busy)
  172.         add_current_char/attr_pair_to_run;
  173.      ELSE
  174.         start_a_new_run_with_char/attr_pair;
  175.      ENDIF
  176.   ENDWHILE
  177.   IF (A_run_is_busy)
  178.      Write_run_to_disk;
  179.   ENDIF
  180.  
  181.   It looks simple, but implementing it effectively is tricky.  The most
  182.   involving part will be the "Stop_this_run_for_whatever_reason" routine.
  183.   There are several reasons for wishing to stop the run.
  184.     1) The current run is 64 characters wide, thus, another char/attr pair
  185.        can't be added.
  186.     2) The current compression can no longer be maintained as the new
  187.        char/attr pair does not match.
  188.     3) Aborting the run prematurely offers a possibility to restart using a
  189.        better compression method.
  190.   Reasons 1 and 2, are easy enough to deal with, the third provides the path
  191.   to optimal compression.  The better the conditions are made for aborting in
  192.   favour of a better compression method, the better compression will be.
  193.  
  194.   Enough about theory, on to the actual code.
  195. }
  196.  
  197. PROCEDURE XBIN_Compress (VAR BIN:BINChrAry; BIN_Width : WORD);
  198.  
  199. CONST NO_COMP       = $00;
  200.       CHAR_COMP     = $40;
  201.       ATTR_COMP     = $80;
  202.       CHARATTR_COMP = $C0;
  203.  
  204. VAR   CompressBuf   : Array[0..2*64] of Byte;
  205.       RunCount      : Word;
  206.       RunMode       : Byte;
  207.       RunChar       : BINChr;
  208.       CB_Index      : Word;            { Index into CompressBuf               }
  209.       BIN_Index     : Word;            { Index into BIN_Line                  }
  210.       EndRun        : Boolean;
  211.  
  212. BEGIN
  213.   RunCount := 0;                       { There's no run busy                  }
  214.   BIN_Index:= 0;
  215.  
  216.   WHILE (BIN_Index<BIN_Width) DO BEGIN { Still characters to process ?        }
  217.      IF (RunCount>0) THEN BEGIN        { A run is busy                        }
  218.         EndRun := FALSE;               { Assume we won't need to end the run  }
  219.  
  220.         IF (RunCount=64) THEN BEGIN    { We reached the longest possible run? }
  221.            EndRun:=TRUE;               { Yes, end the current run             }
  222.         END
  223.         ELSE BEGIN
  224.            { A run is currently busy.  Check to see if we can/will continue...}
  225.            CASE RunMode OF
  226.               NO_COMP       : BEGIN
  227.                 { No compression can always continue, since it does not       }
  228.                 { require on the character and/or attribute to match its      }
  229.                 { predecessor                                                 }
  230.  
  231.                 { === No compression run.  Aborting this will only have       }
  232.                 {     benefit if we can start a run of at least 3 character   }
  233.                 {     or attribute compression. OR a run of at least 2        }
  234.                 {     char/attr compression                                   }
  235.                 {     The required run of 3 (2) takes into account the fact   }
  236.                 {     that a run must be re-issued if no more than 3 (2)      }
  237.                 {     BIN pairs can be compressed                             }
  238.                 IF (BIN_Width-BIN_Index>=2) AND
  239.                    (BIN[BIN_Index].CharAttr=BIN[BIN_Index+1].CharAttr) THEN BEGIN
  240.                    EndRun:=TRUE;
  241.                 END
  242.                 ELSE IF (BIN_Width-BIN_Index>=3) AND
  243.                         (BIN[BIN_Index].Character=BIN[BIN_Index+1].Character) AND
  244.                         (BIN[BIN_Index].Character=BIN[BIN_Index+2].Character) THEN BEGIN
  245.                    EndRun:=TRUE;
  246.                 END
  247.                 ELSE IF (BIN_Width-BIN_Index>=3) AND
  248.                         (BIN[BIN_Index].Attribute=BIN[BIN_Index+1].Attribute) AND
  249.                         (BIN[BIN_Index].Attribute=BIN[BIN_Index+2].Attribute) THEN BEGIN
  250.                    EndRun:=TRUE;
  251.                 END
  252.               END;
  253.  
  254.               CHAR_COMP     : BEGIN
  255.                 { Character compression needs to be ended when the new        }
  256.                 { character no longer matches the run-character               }
  257.                 IF (BIN[BIN_Index].Character<>RunChar.Character) THEN BEGIN
  258.                    EndRun:=TRUE;
  259.                 END
  260.                 { === Aborting an character compression run will only have    }
  261.                 {     benefit if we can start a run of at least 3 char/attr   }
  262.                 {     pairs.                                                  }
  263.                 ELSE IF (BIN_Width-BIN_Index>=3) AND
  264.                         (BIN[BIN_Index].CharAttr=BIN[BIN_Index+1].CharAttr) AND
  265.                         (BIN[BIN_Index].CharAttr=BIN[BIN_Index+2].CharAttr) THEN BEGIN
  266.                    EndRun:=TRUE;
  267.                 END
  268.               END;
  269.  
  270.               ATTR_COMP     : BEGIN
  271.                 { Attribute compression needs to be ended when the new        }
  272.                 { attribute no longer matches the run-attribute               }
  273.                 IF (BIN[BIN_Index].Attribute<>RunChar.Attribute) THEN BEGIN
  274.                    EndRun:=TRUE;
  275.                 END
  276.                 { === Aborting an attribute compression run will only have    }
  277.                 {     benefit if we can start a run of at least 3 char/attr   }
  278.                 {     pairs.                                                  }
  279.                 ELSE IF (BIN_Width-BIN_Index>=3) AND
  280.                         (BIN[BIN_Index].CharAttr=BIN[BIN_Index+1].CharAttr) AND
  281.                         (BIN[BIN_Index].CharAttr=BIN[BIN_Index+2].CharAttr) THEN BEGIN
  282.                    EndRun:=TRUE;
  283.                 END
  284.               END;
  285.  
  286.               CHARATTR_COMP : BEGIN
  287.                 { Character/Attribute compression needs to be ended when the  }
  288.                 { new char/attr no longer matches the run-char/attr           }
  289.                 IF (BIN[BIN_Index].CharAttr<>RunChar.CharAttr) THEN BEGIN
  290.                    EndRun:=TRUE;
  291.                 END
  292.                 { === Aborting a char/attr compression will never yield any   }
  293.                 {     benefit                                                 }
  294.               END;
  295.            END; { CASE }
  296.         END; { IF }
  297.  
  298.         IF EndRun THEN BEGIN
  299.            CompressBuf[0] := RunMode + (RunCount-1);
  300.            STM_Write(XB,CompressBuf,CB_Index);
  301.            IF (XB.LastErr<>STM_OK) THEN Abort('Error Writing File');
  302.  
  303.            RunCount:=0;                { Run no longer busy                   }
  304.         END; { IF }
  305.      END; { IF }
  306.  
  307.      IF (RunCount>0) THEN BEGIN        { Run is still busy ?                  }
  308.          { === Add new char/attr to current run as appropriate for compression}
  309.          {     method in use                                                  }
  310.          CASE RunMode OF
  311.             NO_COMP       : BEGIN
  312.                { Store Char/Attr pair                                         }
  313.                CompressBuf[CB_Index]:=BIN[BIN_Index].Character;
  314.                CompressBuf[CB_Index+1]:=BIN[BIN_Index].Attribute;
  315.                Inc(CB_Index,2);
  316.             END;
  317.  
  318.             CHAR_COMP     : BEGIN
  319.                { Store Attribute                                              }
  320.                CompressBuf[CB_Index]:=BIN[BIN_Index].Attribute;
  321.                Inc(CB_Index);
  322.             END;
  323.  
  324.             ATTR_COMP     : BEGIN
  325.                { Store character                                              }
  326.                CompressBuf[CB_Index]:=BIN[BIN_Index].Character;
  327.                Inc(CB_Index);
  328.             END;
  329.  
  330.             CHARATTR_COMP : BEGIN
  331.                { Nothing to change, only RunCount ever changes                }
  332.             END;
  333.          END;
  334.      END
  335.      ELSE BEGIN                        { Run not busy, Start a new one        }
  336.          CB_Index := 1;                { Skip index 0 (for run-count byte)    }
  337.  
  338.          IF (BIN_Width-BIN_Index>=2) THEN BEGIN { At least 2 more to do       }
  339.             IF (BIN[BIN_Index].CharAttr=BIN[BIN_Index+1].CharAttr) THEN
  340.                { === We can use char/attr compression                         }
  341.                RunMode:=CHARATTR_COMP
  342.             ELSE IF (BIN[BIN_Index].Character=BIN[BIN_Index+1].Character) THEN
  343.                { === We can use character compression                         }
  344.                RunMode:=CHAR_COMP
  345.             ELSE IF (BIN[BIN_Index].Attribute=BIN[BIN_Index+1].Attribute) THEN
  346.                { === We can use attribute compression                         }
  347.                RunMode:=ATTR_COMP
  348.             ELSE
  349.                { === We can't use any compression                             }
  350.                RunMode:=NO_COMP;
  351.          END
  352.          ELSE                          { Last character, use no-compression   }
  353.             RunMode:=NO_COMP;
  354.  
  355.          IF (RunMode=ATTR_COMP) THEN BEGIN
  356.                                        { Attr compression has Attr first !!   }
  357.             CompressBuf[CB_Index]:=BIN[BIN_Index].Attribute;
  358.             CompressBuf[CB_Index+1]:=BIN[BIN_Index].Character;
  359.          END
  360.          ELSE BEGIN
  361.             CompressBuf[CB_Index]:=BIN[BIN_Index].Character;
  362.             CompressBuf[CB_Index+1]:=BIN[BIN_Index].Attribute;
  363.          END;
  364.  
  365.          Inc(CB_Index,2);
  366.          RunChar.CharAttr:=BIN[BIN_Index].CharAttr;
  367.      END; { IF }
  368.  
  369.      Inc(RunCount);                    { RunCount is now one more             }
  370.      Inc(BIN_Index);                   { One char/attr pair processed         }
  371.   END;
  372.  
  373.   IF (RunCount>0) THEN BEGIN
  374.      CompressBuf[0] := RunMode + (RunCount-1);
  375.      STM_Write(XB,CompressBuf,CB_Index);
  376.      IF (XB.LastErr<>STM_OK) THEN Abort('Error Writing File');
  377.   END;
  378. END;
  379.  
  380. {███ XBIN Compression END ███████████████████████████████████████████████████}
  381.  
  382.  
  383. BEGIN { *** MAIN *** }
  384.   WriteLn ('ADF TO XBIN Converter V1.00.');
  385.   WriteLn ('Coded by Tasmaniac / ACiD.');
  386.   WriteLn ('Sourcecode placed into the public domain, use and modify freely');
  387.   WriteLn;
  388.  
  389.   { --- Check passed parameter ------------------------------------------- }
  390.   IF (ParamCount<>2) THEN HelpText;
  391.  
  392.   { --- Open ADF --------------------------------------------------------- }
  393.   WriteLn ('Opening ADF...');
  394.   STM_Open(ADF, ParamStr(1), NOCREATE);
  395.   IF (ADF.LastErr<>STM_OK) THEN Abort('Error opening ADF file '+ParamStr(1));
  396.  
  397.   { --- Determine size of unSAUCED ADF ----------------------------------- }
  398.   WriteLn ('Determining actual size of ADF...');
  399.   ADFSize := STM_GetSize(ADF);
  400.   IF (ADF.LastErr<>STM_OK) THEN Abort('Error determinig size of ADF file');
  401.  
  402.   STM_Goto(ADF,ADFSize-Sizeof(SAUCE));
  403.   IF (ADF.LastErr<>STM_OK) THEN Abort('Error seeking SAUCE info in ADF file');
  404.  
  405.   STM_Read(ADF,SAUCE,sizeof(SAUCE));
  406.   IF (ADF.LastErr<>STM_OK) THEN Abort('Error reading SAUCE info from ADF file');
  407.  
  408.   IF (SAUCE.ID=SAUCE_ID) THEN BEGIN
  409.      Dec(ADFSize,sizeof(SAUCE));{ Reduce ADF size, accounting for SAUCE }
  410.  
  411.      IF (SAUCE.Comments>0) THEN BEGIN
  412.                         { Commentblock added to Sauce, check if it's valid }
  413.         STM_Goto(ADF,ADFSize-(SAUCE.Comments*64)-5);
  414.         IF (ADF.LastErr<>STM_OK) THEN Abort('Error seeking SAUCE COMMENT info in ADF file');
  415.  
  416.         STM_Read(ADF,CMT,sizeof(CMT));
  417.         IF (ADF.LastErr<>STM_OK) THEN Abort('Error reading SAUCE info from ADF file');
  418.  
  419.         IF (CMT<>CMT_ID) THEN
  420.            Abort('Invalid SAUCE COMMENT block in ADF');
  421.         DEC(ADFSize,(SAUCE.Comments*64)+5); { Adjust to account for comments }
  422.      END;
  423.  
  424.      Dec(ADFSize);   { Account for EOF character preceding Sauce & comment }
  425.      IF (SAUCE.FileSize<>ADFSize) THEN
  426.         Abort('Calculated size of ADF and size according to SAUCE don''t match');
  427.   END;
  428.  
  429.   Lines := (ADFSize - 1 - 192 - 4000) DIV 160; { Number lines in ADF }
  430.  
  431.   STM_Goto(ADF,1);                     { Start of ADF, skip version byte }
  432.   IF (ADF.LastErr<>STM_OK) THEN Abort('Error seeking to start of ADF');
  433.  
  434.   { ===========================  CREATE XBIN  ============================ }
  435.   WriteLn ('Creating XBIN...');
  436.   STM_Create(XB,Paramstr(2));
  437.   IF (XB.LastErr<>STM_OK) THEN Abort('Error creating XBIN file '+ParamStr(2));
  438.  
  439.   { --- Write Header ----------------------------------------------------- }
  440.   WriteLn ('Writing XBIN header...');
  441.   XBHdr.ID      := XB_ID; { 'XBIN' ID                       }
  442.   XBHdr.EofChar := 26;    { Mark EOF when TYPEing XBIN      }
  443.   XBHDr.Width   := 80;    { ADF is always 80 wide           }
  444.   XBHdr.Height  := Lines; { This is what we just calculated }
  445.   XBHdr.FontSize:= 16;    { Fonts in ADF are 16 pixels high }
  446.   XBHdr.Flags   := $0F;   { Palette present, Font present, Compresed, }
  447.                           { Non-Blinking (ADF doesn't have blinking), }
  448.                           { 256 character font                        }
  449.   STM_Write(XB,XBHdr,Sizeof(XBHdr));
  450.   IF (XB.LastErr<>STM_OK) THEN Abort('Error writing XBIN file');
  451.  
  452.   { --- Copy Palette ----------------------------------------------------- }
  453.   WriteLn ('Copying palette from ADF to XBIN...');
  454.   STM_Read (ADF,ADFPal,sizeof(ADFPal));
  455.   IF (ADF.LastErr<>STM_OK) THEN Abort('Error reading palette from ADF file');
  456.   { For some reason ADF stores 64 palette values while only 16 colors can  }
  457.   { be active at any one time.  Copy the relevant portion of this palette  }
  458.   {  to the XBIN                                                           }
  459.   FOR Counter:=0 TO 15 DO BEGIN
  460.      STM_Write(XB,ADFPal[STD_EGA_TO_VGA_PAL[Counter]*3],3);
  461.      IF (XB.LastErr<>STM_OK) THEN Abort('Error writing palette in XBIN file');
  462.   END;
  463.  
  464.   { --- Copy Font -------------------------------------------------------- }
  465.   WriteLn ('Copying font from ADF to XBIN...');
  466.   STM_Read (ADF,ADFFont,sizeof(ADFFont));
  467.   IF (ADF.LastErr<>STM_OK) THEN Abort('Error reading font from ADF file');
  468.  
  469.   STM_Write(XB,ADFFont,sizeof(ADFFont));
  470.   IF (XB.LastErr<>STM_OK) THEN Abort('Error writing font in XBIN file');
  471.  
  472.   { --- Write image data ------------------------------------------------- }
  473.   WriteLn('Converting image data from ADF to XBIN...');
  474.   FOR Lines:=1 to XBHdr.Height DO BEGIN
  475.      STM_Read (ADF,BIN,160); { Read one screen line }
  476.      IF (ADF.LastErr<>STM_OK) THEN Abort('Error reading image date from ADF file');
  477.  
  478.      Write(Lines,'/',XBHdr.Height,#13);
  479.      XBIN_Compress(BIN,XBHdr.Width);
  480.   END;
  481.   Write('':79,#13);
  482.  
  483.   STM_Close(ADF);
  484.   STM_Close(XB);
  485.  
  486.   WriteLn ('Conversion complete.');
  487. END.
  488.  
  489.  
  490.  
  491.  
  492.  
  493.  
  494.